home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / qbsnip.zip / DELDUPE.BAS < prev    next >
BASIC Source File  |  1997-06-19  |  3KB  |  154 lines
  1. '    Date: 06-10-97  23:01
  2. '    From: Benjamin L Mcgee
  3. '  e-mail: benjamin.l.mcgee@purgatorie.org
  4. 'NET-MAIL: Benjamin L McGee on 1:15/7
  5. '      To: Isaac Grover
  6. '
  7. 'On 06-06-97 Isaac Grover wrote to All...
  8. '
  9. ' IG> My intent is to first eliminate duplicate site names in the file,
  10. ' IG> possibly by using a temporary file, then plugging each of those
  11. ' IG> sites into a unit of a string array called site$.  How do I
  12. ' IG> figure out how many units the array must contain, then how could
  13. ' IG> I eliminate duplicates without using a swap file if possible?
  14. '
  15. 'I whipped up something that should do just that.  Tried it on a file with
  16. '2669 file names, listed one per line.  I ran out of memory at line 2249,
  17. 'and by the time it had processed 2000 lines it was down to about one line
  18. 'per second.  Hope it helps.
  19.  
  20. ' PUBLIC
  21. CONST FALSE% = 0
  22. CONST TRUE% = NOT FALSE%
  23. DECLARE FUNCTION ss.outofmemory% ()
  24. DECLARE SUB ss.dump (file%)
  25.  
  26. DECLARE FUNCTION ss.add% (site$)
  27.  
  28. ' PRIVATE
  29. DECLARE FUNCTION ss.test% (site$)
  30. DECLARE FUNCTION ss.preserve% ()
  31. DIM SHARED ss.count AS INTEGER          ' count of strings
  32. DIM SHARED ss.memerror AS INTEGER       ' out of memory flag
  33. REDIM SHARED ss(1) AS STRING            ' string array
  34.  
  35. ON ERROR GOTO ss.error:
  36.  
  37. InFile% = FREEFILE
  38. OPEN "INPUT.DAT" FOR INPUT AS InFile%
  39.  
  40. DO
  41.   INPUT #InFile%, in$
  42.   IF LEN(in$) THEN
  43.     TestCount% = TestCount% + 1
  44.     IF ss.add(in$) = FALSE THEN
  45.       IF ss.outofmemory = TRUE THEN EXIT DO
  46.     END IF
  47.   END IF
  48. LOOP WHILE NOT EOF(InFile%)
  49. CLOSE InFile%
  50.  
  51. OutFile% = FREEFILE
  52. OPEN "CONS:" FOR OUTPUT AS OutFile%
  53. ss.dump (OutFile%)
  54. PRINT #OutFile%, STR$(ss.count) + " lines printed."
  55. PRINT #OutFile%, STR$(TestCount%) + " lines processed."
  56. CLOSE OutFile
  57.  
  58. END
  59.  
  60. ss.error:
  61.   IF ERR = 14 AND ss.memerror = TRUE THEN
  62.     RESUME NEXT
  63.   ELSE
  64.     ERROR ERR: END
  65.   END IF
  66.  
  67. FUNCTION ss.add% (site$)
  68.  
  69. answer% = TRUE
  70. IF ss.test(site$) = TRUE THEN
  71.  
  72.     ' REDIM PRESERVE ss(ss.count + 1) AS STRING
  73.     ' IF ss.memerror = TRUE THEN
  74.     '    answer% = FALSE
  75.     ' END IF
  76.  
  77.     ' sorry REDIM PRESERVE isn't supported by all
  78.     ' QB versions, but that's not MY fault :)
  79.     ' if your QB supports REDIM PRESERVE use it
  80.     ' instead of ss.preserve
  81.  
  82.     answer% = ss.preserve
  83.     IF answer% = TRUE THEN
  84.         ss.count = ss.count + 1
  85.         ss(ss.count) = site$
  86.     END IF
  87. ELSE
  88.  
  89.     answer% = FALSE
  90. END IF
  91.  
  92. ss.add = answer%
  93.  
  94. END FUNCTION
  95.  
  96. SUB ss.dump (file%)
  97.  
  98. FOR iter% = 1 TO ss.count
  99.     PRINT #file%, ss(iter%)
  100. NEXT iter%
  101.  
  102. END SUB
  103.  
  104. FUNCTION ss.outofmemory%
  105.     ss.outofmemory = ss.memerror
  106. END FUNCTION
  107.  
  108. FUNCTION ss.preserve%
  109.  
  110. REDIM temp(ss.count) AS STRING
  111. IF ss.memerror = TRUE THEN
  112.     ss.preserve% = FALSE
  113.     EXIT FUNCTION
  114. ELSE
  115.     FOR iter% = 1 TO ss.count
  116.         temp(iter%) = ss(iter%)
  117.     NEXT iter%
  118. END IF
  119.  
  120.  
  121. REDIM ss(ss.count + 1) AS STRING
  122. IF ss.memerror = TRUE THEN
  123.     ss.preserve% = FALSE
  124.     EXIT FUNCTION
  125. ELSE
  126.     FOR iter% = 1 TO ss.count
  127.         ss(iter%) = temp(iter%)
  128.     NEXT iter%
  129. END IF
  130.  
  131. ss.preserve = TRUE
  132.  
  133. END FUNCTION
  134.  
  135. FUNCTION ss.test% (site$)
  136.  
  137. ' this function IS case sensative!
  138.  
  139. answer% = TRUE
  140.  
  141. IF ss.count% > 0 THEN
  142.     FOR iter% = 1 TO ss.count%
  143.         IF site$ = ss(iter%) THEN
  144.             answer% = FALSE
  145.             EXIT FOR
  146.         END IF
  147.     NEXT iter%
  148. END IF
  149.  
  150. ss.test = answer%
  151.  
  152. END FUNCTION
  153.  
  154.